home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / PCSSP.LZH / PC-SSP.ZIP / POLYOPS.ZIP / DPECS.FOR < prev    next >
Text File  |  1985-11-29  |  3KB  |  91 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE DPECS
  5. C
  6. C        PURPOSE
  7. C           ECONOMIZATION OF A POLYNOMIAL FOR UNSYMMETRIC RANGE
  8. C
  9. C        USAGE
  10. C           CALL DPECS(P,N,BOUND,EPS,TOL,WORK)
  11. C
  12. C        DESCRIPTION OF PARAMETERS
  13. C           P     - DOUBLE PRECISION COEFFICIENT VECTOR OF GIVEN
  14. C                   POLYNOMIAL
  15. C           N     - DIMENSION OF COEFFICIENT VECTOR P
  16. C           BOUND - SINGLE PRECISION RIGHT HAND BOUNDARY OF INTERVAL
  17. C           EPS   - SINGLE PRECISION INITIAL ERROR BOUND
  18. C           TOL   - SINGLE PRECISION TOLERANCE FOR ERROR
  19. C           WORK  - DOUBLE PRECISION WORKING STORAGE OF DIMENSION N
  20. C
  21. C        REMARKS
  22. C           THE INITIAL COEFFICIENT VECTOR P IS REPLACED BY THE
  23. C           ECONOMIZED VECTOR.
  24. C           THE INITIAL ERROR BOUND EPS IS REPLACED BY A FINAL
  25. C           ERROR BOUND.
  26. C           N IS REPLACED BY THE DIMENSION OF THE REDUCED POLYNOMIAL.
  27. C           IN CASE OF AN ARBITRARY INTERVAL (XL,XR) IT IS NECESSARY
  28. C           FIRST TO CALCULATE THE EXPANSION OF THE GIVEN POLYNOMIAL
  29. C           WITH ARGUMENT X IN POWERS OF T = (X-XL).
  30. C           THIS IS ACCOMPLISHED THROUGH SUBROUTINE DPCLD.
  31. C           OPERATION IS BYPASSED IN CASE OF N LESS THAN 1.
  32. C
  33. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  34. C           NONE
  35. C
  36. C        METHOD
  37. C           SUBROUTINE DPECS TAKES AN (N-1)ST DEGREE POLYNOMIAL
  38. C           APPROXIMATION TO A FUNCTION F(X) VALID WITHIN A TOLERANCE
  39. C           EPS OVER THE INTERVAL (0,BOUND) AND REDUCES IT IF POSSIBLE
  40. C           TO A POLYNOMIAL OF LOWER DEGREE VALID WITHIN TOLERANCE
  41. C           TOL.
  42. C           THE COEFFICIENT VECTOR OF THE N-TH SHIFTED CHEBYSHEV
  43. C           POLYNOMIAL IS CALCULATED FROM THE RECURSION FORMULA
  44. C           A(K) = -A(K+1)*K*L*(2*K-1)/(2*(N+K-1)*(N-K+1)).
  45. C           REFERENCE
  46. C           K. A. BRONS, ALGORITHM 37, TELESCOPE 1, CACM VOL. 4, 1961,
  47. C           NO. 3, PP. 151.
  48. C
  49. C     ..................................................................
  50. C
  51.       SUBROUTINE DPECS(P,N,BOUND,EPS,TOL,WORK)
  52. C
  53.       DIMENSION P(1),WORK(1)
  54.       DOUBLE PRECISION P,WORK
  55. C
  56.       FL=BOUND*0.5
  57. C
  58. C        TEST OF DIMENSION
  59. C
  60.     1 IF(N-1)2,3,6
  61.     2 RETURN
  62. C
  63.     3 IF(EPS+ABS(SNGL(P(1)))-TOL)4,4,5
  64.     4 N=0
  65.       EPS=EPS+ABS(SNGL(P(1)))
  66.     5 RETURN
  67. C
  68. C        CALCULATE EXPANSION OF CHEBYSHEV POLYNOMIAL
  69. C
  70.     6 NEND=N-1
  71.       WORK(N)=-P(N)
  72.       DO 7 J=1,NEND
  73.       K=N-J
  74.       FN=(NEND-1+K)*(N-K)
  75.       FK=K*(K+K-1)
  76.     7 WORK(K)=-WORK(K+1)*DBLE(FK)*DBLE(FL)/DBLE(FN)
  77. C
  78. C        TEST FOR FEASIBILITY OF REDUCTION
  79. C
  80.       FN=DABS(WORK(1))
  81.       IF(EPS+FN-TOL)8,8,5
  82. C
  83. C        REDUCE POLYNOMIAL
  84. C
  85.     8 EPS=EPS+FN
  86.       N=NEND
  87.       DO 9 J=1,NEND
  88.     9 P(J)=P(J)+WORK(J)
  89.       GOTO 1
  90.       END
  91.